MacWorld 1995 November/Macworld Nov ’95.toast/Developers/PRAM-Reader-12-Source/PRParamRAM.p

Text File | 1995-07-20 | 5.5 KB | 253 lines | [TEXT/MPPS]

{ PRAM-Reader Source Code
  Copyright by Matthias Wuttke

  Please read the Source Code-ReadMe
}

UNIT PRParamRAM;
INTERFACE
    USES
        Types, Errors, Traps, Memory, ConditionalMacros, MixedMode, OSUtils,
        Files, StandardFile, Script;

    PROCEDURE InitUPPs;

{*** HIGH LEVEL ROUTINES ***}
    FUNCTION ReadPRAMFile(spec: FSSpecPtr): OSErr;
    FUNCTION WritePRAMFile(spec: FSSpecPtr): OSErr;

{*** LOW LEVEL ROUTINES ***}
    PROCEDURE ReadXPRam(where: Ptr; size: Integer);
    PROCEDURE WriteXPRam (where: Ptr; offset: Integer; size: Integer);

IMPLEMENTATION

{ *** PRAM READER FILES *** }

    TYPE
        PRamFile = RECORD
            signature: OSType;        { 'PRRd' }            {   +4 }
            version: Integer;        { 12 }                {   +6 }
            reserved: Integer;                            {   +8 }
            stdPRAM: SysParmType;    { "regular" PRAM }    {  +28 }
            extPRAM: PACKED ARRAY [0..255] OF Byte;        { +284 }
        END;
        PRamFilePtr = ^PRamFile;

    { Writes the contents of the PRAM to a "PRam"-file }
    FUNCTION WritePRAMFile(spec: FSSpecPtr): OSErr;
    VAR
        pram: PRamFilePtr;
        refNum: Integer;
        len: LongInt;
        err: OSErr;

        PROCEDURE Check(err: OSErr);
        BEGIN
            IF err <> noErr THEN
                BEGIN
                    WritePRAMFile := err;

                    IF refNum <> 0 THEN
                        err := FSClose(refNum);

                    IF pram <> NIL THEN
                        DisposePtr(Ptr(pram));

                    Exit(WritePRAMFile);
                END;
        END;

    BEGIN
        refNum := 0;

        Ptr(pram) := NewPtrClear(SizeOf(PRamFile));
        IF pram = NIL THEN
            Check(memFullErr);

        WITH PRam^ DO
            BEGIN
                signature := 'PRRd';
                version := 12;
                reserved := -1;
                stdPRAM := GetSysPPtr^;    { copy regular PRAM - see NIM: OS Utils }
            END;

        ReadXPRam(@pram^.extPRAM, $FF);    { read the entire xPRAM (255 Bytes) }

        err := FSpDelete(spec^);
        err := FSpCreate(spec^, 'PRRd', 'PRam', smSystemScript);
        Check(err);

        err := FSpOpenDF(spec^, fsWrPerm, refNum);
        Check(err);

        len := SizeOf(PRamFile);
        err := FSWrite(refNum, len, Ptr(pram));
        Check(err);

        err := FSClose(refNum);
        WritePRAMFile := err;
    END;

    { Writes a "PRam"-file to the (x)PRAM }
    FUNCTION ReadPRAMFile(spec: FSSpecPtr): OSErr;
    VAR
        pram: PRamFilePtr;
        refNum: Integer;
        len: LongInt;
        err: OSErr;

        PROCEDURE Check(err: OSErr);
        BEGIN
            IF err <> noErr THEN
                BEGIN
                    ReadPRAMFile := err;

                    IF refNum <> 0 THEN
                        err := FSClose(refNum);

                    IF pram <> NIL THEN
                        DisposePtr(Ptr(pram));

                    Exit(WritePRAMFile);
                END;
        END;

        PROCEDURE RestorePRAM(offs, len: Integer);
        BEGIN
            WriteXPRam(@pram^.extPRAM[offs], offs, len);
        END;

    BEGIN
        refNum := 0;

        Ptr(pram) := NewPtr(SizeOf(PRamFile));
        IF pram = NIL THEN
            Check(memFullErr);

        err := FSpOpenDF(spec^, fsRdPerm, refNum);
        Check(err);

        len := SizeOf(PRamFile);
        err := FSRead(refNum, len, Ptr(pram));
        Check(err);

        err := FSClose(refNum);
        Check(err);

        refNum := 0;

        IF (pram^.signature = 'PRRd') AND (pram^.version = 12) THEN
            BEGIN
                GetSysPPtr^ := pram^.stdPRAM;
                err := WriteParam;                { write "regular" PRAM }

                {restore xPRAM - see xPRAM map}
                RestorePRAM($01,  1);
                RestorePRAM($08,  4);
                RestorePRAM($10, 16);
                RestorePRAM($76,  1);
                RestorePRAM($78, 16); { $78:4; $7C:2; $7E:1; $7F:1; $80:2; $82:6 }
                RestorePRAM($8A,  1);
                RestorePRAM($AF,  1);
                RestorePRAM($BD, 33);
                RestorePRAM($DE,  2);
                RestorePRAM($E0,  4);
                RestorePRAM($E4, 12);
            END
        ELSE
            Check(envBadVers); { bad version respectively file format }

        DisposePtr(Ptr(pram));
        ReadPRAMFile := noErr;
    END;

{ *** LOW LEVEL PRAM READ/WRITE ROUTINES *** }

    CONST
        _ReadXPRam = $A051;
        _WriteXPRam = $A052;

{$IFC GENERATINGPOWERPC}

    CONST
        ReadXPRamProcInfo = 235522;        { no result, parameters in A0, D0 }
        WriteXPRamProcInfo = 235522;

    TYPE
        IntLong = RECORD
                    CASE Integer OF
                        1: (hi, lo: Integer);
                        2: (l: LongInt);
                  END;

    VAR
        ReadXPRamUPP: UniversalProcPtr;
        WriteXPRamUPP: UniversalProcPtr;

    PROCEDURE InitUPPs;
    BEGIN
        ReadXPRamUPP := NGetTrapAddress(_ReadXPRam, OSTrap);
        WriteXPRamUPP := NGetTrapAddress(_WriteXPRam, OSTrap);
    END;

    PROCEDURE ReadXPRam(where: Ptr; size: Integer);
    VAR
        l: IntLong;
        err: OSErr;
    BEGIN
    { pass offset in lo word of D0, size in hi word; pass bufPtr in A0 }
        l.lo := 0;
        l.hi := size;
        err := CallOSTrapUniversalProc(ReadXPRamUPP, ReadXPRamProcInfo, where, l.l);
    END;

    PROCEDURE WriteXPRam (where: Ptr; offset: Integer; size: Integer);
    VAR
        l: IntLong;
        err: OSErr;
    BEGIN
    { pass offset in lo word of D0, size in hi word; pass bufPtr in A0 }
        l.lo := offset;
        l.hi := size;
        err := CallOSTrapUniversalProc(WriteXPRamUPP, WriteXPRamProcInfo, where, l.l);
    END;

{$ELSEC}

    PROCEDURE InitUPPs;
    BEGIN
    { need no UPPs for 68K-Macs }
    END;

    PROCEDURE InlineReadXPRam (where: Ptr; size: Integer);
    INLINE
        $4280,    { CLR.L D0 }
        $301F,     { MOVE.W (A7)+, D0 }
        $4840,     { SWAP D0 }
        $205F,     { MOVEA.L (A7)+, A0 }
        _ReadXPRam;        { offs: LoWord(D0); size: HiWord(D0); buffer: A0 }

    PROCEDURE InlineWriteXPRam (where: Ptr; offset: Integer; size: Integer);
    INLINE
        $201F,     { MOVE.L (A7)+, D0 }    { move offs, size --> D0 }
        $205F,     { MOVEA.L (A7)+, A0 }    { move where      --> A0 }
        _WriteXPRam;    { offs: LoWord(D0); size: HiWord(D0); buffer: A0 }

    PROCEDURE ReadXPRam (where: Ptr; size: Integer);
    BEGIN
        InlineReadXPRam(where, size);
    END;

    PROCEDURE WriteXPRam(where: Ptr; offset, size: Integer);
    BEGIN
        InlineWriteXPRam(where, offset, size);
    END;

    { This stub routines are needed because the linker does not export
      inline procedures. }

{$ENDC}

END.